home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / slib / lineio.scm < prev    next >
Encoding:
Text File  |  2004-01-06  |  3.0 KB  |  83 lines
  1. ; "lineio.scm", line oriented input/output functions for Scheme.
  2. ; Copyright (c) 1992, 1993 Aubrey Jaffer
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20.  
  21. ;;@args
  22. ;;@args port
  23. ;;Returns a string of the characters up to, but not including a
  24. ;;newline or end of file, updating @var{port} to point to the
  25. ;;character following the newline.  If no characters are available, an
  26. ;;end of file object is returned.  The @var{port} argument may be
  27. ;;omitted, in which case it defaults to the value returned by
  28. ;;@code{current-input-port}.
  29. (define (read-line . port)
  30.   (let* ((char (apply read-char port)))
  31.     (if (eof-object? char)
  32.     char
  33.     (do ((char char (apply read-char port))
  34.          (clist '() (cons char clist)))
  35.         ((or (eof-object? char) (char=? #\newline char))
  36.          (list->string (reverse clist)))))))
  37.  
  38. ;;@args string
  39. ;;@args string port
  40. ;;Fills @1 with characters up to, but not including a newline or end
  41. ;;of file, updating the @var{port} to point to the last character read
  42. ;;or following the newline if it was read.  If no characters are
  43. ;;available, an end of file object is returned.  If a newline or end
  44. ;;of file was found, the number of characters read is returned.
  45. ;;Otherwise, @code{#f} is returned.  The @var{port} argument may be
  46. ;;omitted, in which case it defaults to the value returned by
  47. ;;@code{current-input-port}.
  48. (define (read-line! str . port)
  49.   (let* ((char (apply read-char port))
  50.      (midx (+ -1 (string-length str))))
  51.     (if (eof-object? char)
  52.     char
  53.     (do ((char char (apply read-char port))
  54.          (i 0 (+ 1 i)))
  55.         ((or (eof-object? char)
  56.          (char=? #\newline char)
  57.          (> i midx))
  58.          (if (> i midx) #f i))
  59.       (string-set! str i char)))))
  60.  
  61. ;;@args string
  62. ;;@args string port
  63. ;;Writes @1 followed by a newline to the given @var{port} and returns
  64. ;;an unspecified value.  The @var{Port} argument may be omitted, in
  65. ;;which case it defaults to the value returned by
  66. ;;@code{current-input-port}.@refill
  67. (define (write-line str . port)
  68.   (apply display str port)
  69.   (apply newline port))
  70.  
  71. ;;@args path
  72. ;;@args path port
  73. ;;Displays the contents of the file named by @1 to @var{port}.  The
  74. ;;@var{port} argument may be ommited, in which case it defaults to the
  75. ;;value returned by @code{current-output-port}.
  76. (define (display-file path . port)
  77.   (set! port (if (null? port) (current-output-port) (car port)))
  78.   (call-with-input-file path
  79.     (lambda (inport)
  80.       (do ((line (read-line inport) (read-line inport)))
  81.       ((eof-object? line))
  82.     (write-line line port)))))
  83.